COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file
C00003 00003	.hd206 FALL 1978
C00009 00004	.LSPFONT
C00017 ENDMK
C⊗;
.REQUIRE "LSPMAC.PUB[LSP,CLT]" source_file;
.PAGE FRAME 56 HIGH 80 WIDE;
.evenleftborder ← oddleftborder ← 1000;
.area text lines 1 to 56;
.place text;
.
.MACRO  hd206 (TERM) ⊂
.BEGIN    NOFILL  TURNON "←→"
←COMPUTER SCIENCE DEPARTMENT
←STANFORD UNIVERSITY
.SKIP  
CS206  ←COMPUTING WITH SYMBOLIC EXPRESSIONS  →TERM
.TURNOFF
.END ⊃
.
.
.MACRO hw (NUMBER, DUEDATE) ⊂
.   BEGIN TURNON "←"  NOFILL
←PROBLEM SET  NUMBER
←Due  DUEDATE
.   TURNOFF END ⊃
.
.itemmac
.
.PORTION MAINPORTION
.
.hd206 FALL 1978
.skip
.hw 1, |October 24|

	Write LISP programs for each of the functions described below.
For each program turn in the following:
.item←0
.begin nofill indent 12,12

	#.  The internal form of the program.
	#.  The corresponding external form recursive definition.
	#.  A description of how the progam works and why.
	#.  Output from test runs on a variety of input.
.end		
	Late assignments are discouraged and will not be accepted after the 
solutions appear.
.bb Function descriptions.
.item ← 0
.BEGIN INDENT 0,6

#. ⊗sizesort[u] returns a permutation of ⊗u which has smaller length sublists
before larger ones.  Atomic elements should be considered to have 0 length.
Sublists of the same size can be in any order.  The following is one i/o
pair which satisfies the function definition.

⊗⊗⊗sizesort[$$(H (D E) (F G H) (D F) B A)$] = $$(H B A (D E) (D F) (F G H))$.⊗

#. ⊗powerset[u] returns the power-set of set ⊗u.  A set is represented as a
list of elements with no repetitions. Order within the list is unimportant.
The following is one i/o pair which satisfies the function definition.

⊗⊗⊗powerset[$$(A B C)$] = $$((A B C) (A B) (A C) (A) (B C) (B) (C) ())$.⊗

#. ⊗allsub[u,v] returns a list giving all occurrences of the list ⊗u 
as a toplevel sublist of ⊗v. An occurrence is given by the number
denoting the position in ⊗v where the match begins.
The following is one i/o pair which satisfies the function definition.

⊗⊗⊗allsub[$$(A A),(A A A A A)$] = $$(1 2 3 4)$.⊗

#. ⊗allsub![u,v] returns a list giving all occurrences of the list ⊗u 
as a sublist of ⊗v, at any level.  Now an occurrence is a list of numbers
giving the path to beginning to sublist occurrence. 
The following is one i/o pair which satisfies the function definition.

⊗⊗⊗allsub![$$(A),(A (B (A (B (A)))))$] = $$((1) (2 2 1) (2 2 2 2 1))$⊗

#.  ⊗mapexp takes as arguments an S-expression, a unary
function ⊗f1 and a binary function ⊗f2.  It takes the S-expression apart,
applies the unary function to each atom and puts the result back 
together using the binary function
Thus if ⊗f1 is the identity function and ⊗f2 is ⊗cons then ⊗maptree returns
a copy of the S-expression.  If ⊗f1 is ⊗ncons (forms a list of one element)
and ⊗f2 is ⊗append then ⊗maptree returns the ⊗fringe of the S-expression.

#.  Let a graph ⊗g be represented as described in Chapter I of the text
and suppose that whenever there is an edge from ⊗x to ⊗y  there is also 
an edge from ⊗y to ⊗x.  A component of the graph is a collection of 
vertices which are all connected to each other by edge paths but not 
connected to any vertices not in this collection.  Write a function
⊗components to determine the components of a graph ⊗g.  

.END

.LSPFONT
.basicops 
.next page
.cb |Functions definitions (external and internal form) for assignment 1.|
.item ← 0

#. ⊗allsub[u,v]  
.begin  nofill select 2 

⊗⊗        allsub[u, v] ← allsub1[u, v, 1]⊗

⊗⊗        allsub1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen n . allsub1[u, qd v, add1 n]⊗
⊗⊗            qelse allsub1[u, qd v, add1 n]⊗

⊗⊗        match[u, v] ← ⊗
⊗⊗            qif qn u qthen qT qelse qif qn v qthen qNIL qelse qa u = qa v ∧ match[qd u, qd v]⊗
.end

.begin nofill select 6

	(DEFUN ALLSUB (U V) (ALLSUB1 U V 1.)) 

	(DEFUN ALLSUB1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V) (CONS N (ALLSUB1 U (CDR V) (ADD1 N))))
		     (T (ALLSUB1 U (CDR V) (ADD1 N))))) 

	(DEFUN MATCH (U V) 
	       (COND ((NULL U) T)
		     ((NULL V) NIL)
		     (T (AND (EQUAL (CAR U) (CAR V))
			     (MATCH (CDR U) (CDR V)))))) 
.end

#. ⊗allsub![u,v] 

.begin nofill select 2

⊗⊗        allsub![u, v] ← allsub!1[u, v, 1]⊗

⊗⊗        allsub!1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen qNIL⊗
⊗⊗            qelse qif match[u, v] qthen <n> . allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse qif qat qa v qthen allsub!1[u, qd v, add1 n]⊗
⊗⊗            qelse tack[n, allsub![u, qa v]] * allsub!1[u, qd v, add1 n]⊗

⊗⊗        tack[n, w] ← qif qn w qthen qNIL qelse [n . qa w] . tack[n, qd w]⊗
.end

.begin nofill select 6

	(DEFUN ALLSUB! (U V) (ALLSUB!1 U V 1.)) 

	(DEFUN ALLSUB!1 (U V N) 
	       (COND ((NULL V) NIL)
		     ((MATCH U V)
		      (CONS (LIST N) (ALLSUB!1 U (CDR V) (ADD1 N))))
		     ((ATOM (CAR V)) (ALLSUB!1 U (CDR V) (ADD1 N)))
		     (T (APPEND (TACK N (ALLSUB! U (CAR V)))
				(ALLSUB!1 U (CDR V) (ADD1 N)))))) 

	(DEFUN TACK (N W) 
	       (COND ((NULL W) NIL)
		     (T (CONS (CONS N (CAR W)) (TACK N (CDR W)))))) 
.end

#.  ⊗mapexp [or ⊗⊗maptree⊗]

.begin nofill select 2

⊗⊗        maptree[s, f1, f2] ← ⊗
⊗⊗            qif qat s qthen f1 s⊗
⊗⊗            qelse f2[maptree[qa s, f1, f2], maptree[qd s, f1, f2]]⊗
.end
.begin nofill select 6

	(DEFUN MAPTREE (S F1 F2) 
	       (COND ((ATOM S) (F1 S))
		     (T (F2 (MAPTREE (CAR S) F1 F2)
			    (MAPTREE (CDR S) F1 F2))))) 
.end

#. ⊗ncomps 
.begin nofill select 2

⊗⊗        ncomps g ← qif qn g qthen 0 qelse add1 ncomps scan[qd g, qNIL, qa g, qNIL]⊗

⊗⊗        scan[g, h, u, flag] ← ⊗
⊗⊗            qif qn g qthen [qif qn flag ∨ qn h qthen h qelse scan[h, qNIL, u, qNIL]]⊗
⊗⊗            qelse qif qn [qaa g ε u] qthen scan[qd g, qa g . h, u, flag]⊗
⊗⊗            qelse scan[qd g, h, u * qa g, qT]⊗
.end


.begin nofill select 6

(DEFUN NCOMPS (G) 
       (COND ((NULL G) 0.)
	     (T (ADD1 (NCOMPS (SCAN (CDR G) NIL (CAR G) NIL)))))) 

(DEFUN SCAN (G H U FLAG) 
       (COND ((NULL G)
	      (COND ((OR (NULL FLAG) (NULL H)) H)
		    (T (SCAN H NIL U NIL))))
	     ((NULL (MEMBER (CAAR G) U))
	      (SCAN (CDR G) (CONS (CAR G) H) U FLAG))
	     (T (SCAN (CDR G) H (APPEND U (CAR G)) T)))) 	       
.end

#. ⊗partition[u,n] 
.begin nofill select 2

⊗⊗        partition[u, n] ← ⊗
⊗⊗            qif length u < n qthen $$(INVALID N)$ qelse part1[<qa u>, qd u, sub1 n]⊗

⊗⊗        part1[u, v, n] ← ⊗
⊗⊗            qif qn v qthen [qif zerop n qthen <<u>> qelse qNIL]⊗
⊗⊗            qelse tack[u, part1[<qa v>, qd v, sub1 n]]⊗
⊗⊗                  * part1[u * <qa v>, qd v, n]⊗

⊗⊗        testpart[v, u] ← ⊗
⊗⊗            qif qn v qthen qT⊗
⊗⊗            qelse combine qa v = u ∧ testpart[qd v, u] ⊗

⊗⊗        combine w ← qif qn w qthen qNIL qelse qa w * combine qd w⊗
.end

.begin nofill select 6

	(DEFUN PARTITION (U N) 
	       (COND ((LESSP (LENGTH U) N) '(INVALID N))
		     (T (PART1 (LIST (CAR U)) (CDR U) (SUB1 N))))) 

	(DEFUN PART1 (U V N) 
	       (COND ((NULL V) (COND ((ZEROP N) (LIST (LIST U))) (T NIL)))
		     (T (APPEND (TACK U
				      (PART1 (LIST (CAR V)) (CDR V) (SUB1 N)))
				(PART1 (APPEND U (LIST (CAR V)))
				       (CDR V)
				       N))))) 

	(DEFUN LINK (U W) 
	       (COND ((NULL W) NIL)
		     (T (CONS (CONS U (CAR W)) (LINK U (CDR W)))))) 

	(DEFUN TESTPART (V U) 
	       (COND ((NULL V) T)
		     ((AND (EQUAL (COMBINE (CAR V)) U)
			   (TESTPART (CDR V) U))))) 

	(DEFUN COMBINE (W) 
	       (COND ((NULL W) NIL) (T (APPEND (CAR W) (COMBINE (CDR W)))))) 
.end